1 Chargement des données et mise en forme

1.1 Chargement

fait.dat <- read.csv("data/fait.txt")
implantation.dat <- read.csv("data/implantation.txt")
# on retire le num de ligne qui était passe en X
fait.dat <- subset(fait.dat, select = - X)
implantation.dat <- subset(implantation.dat, select = - X)

1.2 Mise en forme

relation.dat <- fait.dat[fait.dat$caracNew == "Relations" ,] # on ne garde que les relations
# on extrait les Déplacement 
relation.dat <- relation.dat[!relation.dat$modaNiv1 == "Déplacement",]
relation <- subset(relation.dat, !(relation.dat$modaNiv1 == "hiérarchique asc. Ecole" | relation.dat$modaNiv1 == "hiérarchique ascendante") )# on enleve les doublons
relation <- subset(relation, select =  c("idimplantation", "usual_name", "fklinked_implantation","linked_implantation_name", "modaNiv1")) # on ne garde que les noms et noms liées
# on drop les facteurs non pris en compte suite aux subset de relations
relation$usual_name <- factor(relation$usual_name)
relation$linked_implantation_name <- factor(relation$linked_implantation_name)
relation$modaNiv1 <- factor(relation$modaNiv1)

Dans un premier temps je ne vais travailler qu’avec les relations représentées par des couples noms d’implantations et noms d’implantations liées. Il s’agira par la suite de complexifier.

2 Description des relations

2.1 Quelques chiffres à garder en tête

2.1.1 Les relations directes

Cela recouvre 1655 relations directes car celles avec hiérarchique asc. Ecole et hiérarchique ascendante ont été retirées (elles doublonnaient). Il y a 403 implantations distinctes (idimplantation) qui sont liées à 1344 implantations liées distinctes (fklinked_implantation).

Le tableau 2.1 et le diagramme en baton 2.1 représentent le nombre de relations que l’on a pour chaque noms d’implantations distincts (idimplantation). Il y a deux implantations (Charroux, Saint-Sauveur et Cluny) qui possèdent 164 et 102 relations puis on obtient un second groupe d’implantations avec un nombre de relations contenues entre 38 et 20. Ensuite les nombre d’implantations possedant de moins en moins de relations va augmenter, presque exponentiellement pour culminer au groupe d’implantations ne possedant qu’une relation (238).

# un tableau avec les Id et les noms
idimplant_court <- subset(implantation.dat, select = c(idimplantation, usual_name))

implantation_relation <- relation %>% 
    group_by(idimplantation) %>% # on groupe par usual name
    summarize(nb = n()) %>%  # on compte par ce group
    arrange(desc(nb)) %>% # on passe en decroissant
    left_join(idimplant_court,by = "idimplantation") # ion rajoute le nom
# une bidouille pour avoir un titre de tableau avec ref
cat("<tableau>",paste0("<caption>", "(#tab:relationusualname)", ' Nombre de relations directes par idimplantation', "</caption>"),"</tableau>", sep ="\n")
Table 2.1: Nombre de relations directes par idimplantation 

DT::datatable(implantation_relation)
gg_implantation_relation <- ggplot(implantation_relation) +
        geom_bar(aes(nb)) + 
        labs(x = "", y = "") +
        theme_bw()
# c'est du js
f <- list(
  family = "Courier New, monospace",
  size = 18,
  color = "#7f7f7f"
)
x <- list(
  title = "Nombre de relations par idimplantation",
  titlefont = f
)
y <- list(
  title = "décompte",
  titlefont = f
)
ggplotly(gg_implantation_relation) %>% 
    layout(xaxis = x, yaxis = y)

Figure 2.1: Diagramme en baton du nombre de relations directes par idimplantation

2.1.2 une carte des implantations par nombre de relations directes

initmapview()
 mapview::mapview(diocese.shp, color = "white",  lwd = 1, # couleur et type du contour
                      col.regions = "grey",  alpha = 0.5,                  # couleur du fond et type
                      layer.name = "Diocèses" ) +
 mapview::mapview(implantation.shp, cex = 0.1, layer.name = "Implantations", col.regions = "black") +
 mapview::mapview(implantation_relation.shp, cex = "nb", layer.name = "implantations avec relations")
## Warning in validateCoords(lng, lat, funcName): Data contains 1 rows with
## either missing or invalid lat/lon values and will be ignored
## Warning in validateCoords(lng, lat, funcName): Data contains 24 rows with
## either missing or invalid lat/lon values and will be ignored

Comme le message d’erreur l’indique il y a 24 implantations dont on ne posséde par les coordonnées et une ligne d’erreur.

3 Des graphes

3.1 Un graphe non orienté pour commencer

# je prefere des caracteres donc autant garder une syntaxe V pour vertex
relation_graph <- subset(relation, select = c(idimplantation, fklinked_implantation, modaNiv1))
relation_graph$idimplantation <-  paste0("V", relation_graph$idimplantation)
relation_graph$fklinked_implantation <- paste0("V", relation_graph$fklinked_implantation)

implantation.dat$name <- paste0("V", implantation.dat$idimplantation)

# on garde pas tout, il est important que le première colonne contienne les noms de vertex cf help(grap.data.frame)
implantationVertex.dat <- implantation.dat[,c(16,2,3,9:11)] 


# le match est un peu tricky ici car utilisé pour réduire (et ordonner ce qui ne change rien) au vertex ayant des relations
implantationVertexv2.dat <- implantationVertex.dat[match(unique(c(relation_graph$idimplantation, 
                                                        relation_graph$fklinked_implantation)), implantationVertex.dat$name),]
graph_relation <- graph.data.frame(relation_graph, 
                                   directed = FALSE, 
                                   vertices = implantationVertexv2.dat) # c'est ici qu' on indique les attributs des vertex, il faut que la première colonne corresponde à celle des vertexes cf help(graph.data.frame) details 3 paragraphs

E(graph_relation)$weight <- 1
# on fait le nouveau graph avec le poids 
graph_ensemble_simplify <- simplify(graph_relation, edge.attr.comb = list(weight="sum", "ignore"))

Le premier graphe que l’on obtient comporte des liens doubles (244) et même triples (cf. tableau 3.1), c’est à dire que l’on peut avoir plusieurs relations entre deux noeuds (implantations). C’est logique vu que les relations et les implantations peuvent évoluer au cours du temps. C’est quelque chose que nous allons devoir observer plus en detail. Dans un premier temps, une solution est de les regrouper pour en faire un “poids”, plus ce poids est importants plus ces implantations possèdent des relations (cela suppose de mettre en équivalance les relations sur le principe d’une relation = une relation).

knitr::kable(table(E(graph_ensemble_simplify)$weight), col.names = c("Poids des liens", "Fréquences"), caption = "Répartition des poids indiquant le nombre de liens doubles ou triples")
Table 3.1: Répartition des poids indiquant le nombre de liens doubles ou triples
Poids des liens Fréquences
1 1190
2 198
3 23

Soit : 244 liens multiple pour 1411 liens.

#on en fait un tableau
lien_unique.dat <- data.frame(
    V(graph_ensemble_simplify)$name, # la première colonne correspond au nom de vertexes
    degree(graph_ensemble_simplify)) # la seconde au degrée,
names(lien_unique.dat) <- c("name", "lien_unique") # on renome ces colonnes
# puis on en fait une jointure sur les implantations
lien_unique_join.dat <- left_join(lien_unique.dat, implantationVertex.dat, by = c("name"="name"))
## Warning: Column `name` joining factor and character vector, coercing into
## character vector
DT::datatable(lien_unique_join.dat)

Le nombre de liens que posède un noeud correspond au degré.

3.2 Une première visualisation.

Le réseau 3.1 différencie plusieurs types de clusters : des très petits groupes de quelques relations (parfois juste une) et des groupes très étoilées d’un grand nombre d’implantations. Les liens simple sont en vert, les doubles en orange et les triples en rouge.

# un vecteur de couleur pour les edges
E(graph_ensemble_simplify)$colorW <- ifelse(E(graph_ensemble_simplify)$weight == 1, "forestgreen",
                                            ifelse(E(graph_ensemble_simplify)$weight == 2, "orange", "red"))
V(graph_ensemble_simplify)$colorV <- "gray60"

# ici u vecteur qui compte les voisins d'orde 1
un.voisin <- graph.neighborhood(graph_ensemble_simplify, order = 1) # attention la fonction evolue vers ego_size


graphjs(graph_ensemble_simplify, 
        vertex.label = paste(V(graph_ensemble_simplify)$usual_name, V(graph_ensemble_simplify)$name) , # ici on mets le nom de l'implantation
        vertex.color = V(graph_ensemble_simplify)$colorV, # la couleur pour les vertexs
        vertex.size = log(sapply(un.voisin, vcount))/10, # la taille des noeuds = au log(voisin orde 1)/10 
                                                         # c'est pas fou mais je veux un truc de 0.1 à 0.5
        edge.color = E(graph_ensemble_simplify)$colorW, # on reutilise le vecteur de couleurs ici que trois couleurs produites ..
        brush=TRUE)

Figure 3.1: Réseau des relations simplifiées entre col&mon

Un reseau minimum doit comporter un lien et deux noeuds. Avec trois noeuds, il faut trois liens. Dès quatre noeuds cela se complique fortement, seulement trois liens sont necessaires mais 6 sont possibles. Cependant le triangle est le nombre maximum pour les cliques que l’on obtient dans notre cas :

knitr::kable(table(sapply(cliques(graph_ensemble_simplify), length)))
Var1 Freq
1 1598
2 1411
3 35

Le tableau ci dessous présente le nombre de composantes connexes pour le réseau 3.1. On en obtient 243. (ce tableau est une petite truanderie qui marche vu la faible densité de notre réseau)

comps <- decompose.graph(graph_ensemble_simplify)
comp_connexe <- data.frame(table(sapply(comps, vcount)),
table(sapply(comps, ecount)))
names(comp_connexe) <- c("nbr de noeud", "nbr de comp. connexe", "nbr de liens", "nbr de comp. connexe")
DT::datatable(comp_connexe)

Une très grande majorité des relations sont des “hiérarchique descendante” pour rappel :

knitr::kable(table(relation_graph$modaNiv1))
Var1 Freq
hiérarchique desc. Ecole 179
hiérarchique descendante 1330
Relation horizontale 146

Du coup pour le moment je pense que cela fait plus sens de changer la couleur par type de modaNiv1, Pour aller vite j’ai pris la première modalité dans le jeux de données, une meme modalité se répetant mais pas toujours, il faudra affiner.

“hiérarchique descendante” est “forestgreen”, “hiérarchique desc. Ecole” est en “yellow” et Relation horizontale est en “rouge”

# cést le first ici "concat"
graph_ensemble_simplify <- simplify(graph_relation, edge.attr.comb = list(weight="sum", modaNiv1 = "first")) 

un.voisin <- graph.neighborhood(graph_ensemble_simplify, order = 1) # attention la fonction evolue vers ego_size

# un vecteur de couleur pour les edges
E(graph_ensemble_simplify)$colorW <- ifelse(E(graph_ensemble_simplify)$modaNiv1 == "hiérarchique descendante", "forestgreen",
                                            ifelse(E(graph_ensemble_simplify)$modaNiv1 ==  "hiérarchique desc. Ecole", "yellow", "red"))


# un vecteur de couleur pour les vertexes
V(graph_ensemble_simplify)$colorV <- "gray60"

graphjs(graph_ensemble_simplify, 
        vertex.label = paste(V(graph_ensemble_simplify)$usual_name, V(graph_ensemble_simplify)$name),
        vertex.color = V(graph_ensemble_simplify)$colorV,
        vertex.size = log(sapply(un.voisin, vcount))/10,
        edge.color = E(graph_ensemble_simplify)$colorW)